home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / var / lib / defoma / scripts / gs.defoma < prev    next >
Text File  |  2009-10-28  |  21KB  |  931 lines
  1. #
  2. # gs.defoma: Defoma support for Ghostscripts
  3. #
  4.  
  5. @ACCEPT_CATEGORIES = qw(type1 type3 gsfontderivative truetype cid
  6.             cmap psprint);
  7.  
  8. package gs;
  9. use strict;
  10. use POSIX;
  11.  
  12. use vars qw($DEFOMA_TEST_DIR $ROOTDIR);
  13.  
  14. use Debian::Defoma::Common;
  15. use Debian::Defoma::Font;
  16. use Debian::Defoma::Id;
  17. use Debian::Defoma::Subst;
  18. import Debian::Defoma::Font;
  19. import Debian::Defoma::Id;
  20. import Debian::Defoma::Subst;
  21. import Debian::Defoma::Common;
  22.  
  23. my $Id;
  24. my $IdCmap;
  25. my $Sb1;
  26. my $Sb2;
  27.  
  28. my $PkgDir = "$ROOTDIR/gs.d";
  29. my $CidDir = "$PkgDir/dirs/CIDFont";
  30. my $CMapDir = "$PkgDir/dirs/CMap";
  31. my $TTCidDir = "$PkgDir/dirs/TTCIDFont";
  32. my $FontDir = "$PkgDir/dirs/fonts";
  33. my $FontMap = "$FontDir/Fontmap";    # F
  34. my $CIDFontMap = "$FontDir/CIDFnmap";    # FF
  35. my $Subst4psprint = 0;
  36. # For Ghostscript 8 or later
  37. my $FAPIfmap = "$FontDir/FAPIfontmap";    # FFF
  38. my $Cidfmap = "$FontDir/cidfmap";    # FFFF
  39.  
  40. sub init {
  41.   unless ($Id) {
  42.     $Id = defoma_id_open_cache();
  43.   }
  44.   unless ($IdCmap) {
  45.     $IdCmap = defoma_id_open_cache('cmap');
  46.   }
  47.   unless ($Sb1) {
  48.     $Sb1 = defoma_subst_open(rulename => 'psprint', threshold => 50,
  49.                  idobject => $Id, private => 1);
  50.   }
  51.   unless ($Sb2) {
  52.     $Sb2 = defoma_subst_open(rulename => 'ghostscript', threshold => 30,
  53.                  idobject => $Id);
  54.   }
  55.   
  56.   return 0;
  57. }
  58.  
  59. sub term {
  60.   my @list;
  61.   my $i;
  62.   
  63.   if ($Id) {
  64.     if (open(F, '>' . $FontMap) && open(FF, '>' . $CIDFontMap) &&
  65.     open(FFF, '>' . $FAPIfmap) && open(FFFF, '>' . $Cidfmap)) {
  66.       @list = defoma_id_get_font($Id, 'installed');
  67.       
  68.       foreach $i (@list) {
  69.         next if ($Id->{2}->[$i] ne 'SrI');
  70.         my $c = $Id->{4}->[$i];
  71.         my $f;
  72.         my @h;
  73.         my $cmap;
  74.         my @cmaplist;
  75.         my $j;
  76.         my @ch;
  77.         my %hh;
  78.         
  79.         if ($c =~ /^(type1|type3|gsfontderivative)$/) {
  80.           $f = $Id->{1}->[$i];
  81.           $f =~ s/^.*\///;
  82.           #
  83.           # Spit out $FontDir/Fontmap
  84.           #
  85.           print F '/', $Id->{0}->[$i], ' (', $f, ") ;\n";
  86.         } elsif ($c =~ /^truetype$/) {
  87.           $f = $Id->{1}->[$i];
  88.           #
  89.           # Spit out $FontDir/FAPIfontmap
  90.           #
  91.           # FIXME: need to support the sub font id for the collection.
  92.           print FFF '/', $Id->{0}->[$i], ' << /Path (', $f, ') /FontType 1 /FAPI /FreeType /SubfontId ', '0' , " >> ;\n"
  93.         } elsif ($c =~ /^(truetype-cjk|cid)$/) {
  94.           $f = $Id->{1}->[$i];
  95.           @h = split(/ +/, $Id->{7}->[$i]);
  96.           #
  97.           # Spit out $FontDir/CIDFnmap
  98.           #
  99.           print FF '/', $Id->{0}->[$i], ' (', $f, ') ';
  100.           if ($c eq 'truetype-cjk') {
  101.         print FF '/', $h[0], '-', $h[1], '-', $h[2];
  102.           }
  103.           print FF " ;\n";
  104.           # For Ghostscript 8 or later
  105.           if ($c eq 'truetype-cjk') {
  106.         my @hints = defoma_id_get_hints( $Id, $i );
  107.         my $cidsupplement;
  108.         while (@hints) {
  109.           my $var = shift @hints;
  110.           if ($var eq "--CIDSupplement") {
  111.             $cidsupplement = shift @hints;
  112.             last;
  113.           }
  114.         }
  115.         unless (defined $cidsupplement) {
  116.           print STDERR "No CIDSupplement specified for $Id->{0}->[$i], defaulting to 0.\n";
  117.           $cidsupplement = 0;
  118.         }
  119.         #
  120.         # Spit out $FontDir/cidfmap
  121.         #
  122.         # FIXME: need to support the sub font id for the collection.
  123.         print FFFF '/', $Id->{0}->[$i], ' << /FileType /TrueType /Path (', $f, ') /SubfontID ', '0', ' /CSI [(', $h[6], ') ', $cidsupplement, "] >> ;\n";
  124.           }
  125.         }
  126.       }
  127.       
  128.       @list = defoma_id_get_font($Id, 'installed');
  129.       
  130.       foreach $i (@list) {
  131.         next if ($Id->{2}->[$i] !~ /^.[aS]/);
  132.         
  133.         my $c = $Id->{4}->[$i];
  134.         #
  135.         # Spit out aliases
  136.         #        
  137.         if ($c =~ /^(truetype|type1|type3|gsfontderivative)$/) {
  138.           print F '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ; \n";
  139.           print FFF '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ; \n";
  140.         } elsif ($c =~ /^(truetype-cjk|cid)$/) {
  141.           print FF '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ;\n";
  142.           print FFFF '/', $Id->{0}->[$i], ' /', $Id->{5}->[$i], " ;\n";
  143.         }
  144.         
  145.       }
  146.       
  147.       close F;
  148.       close FF;
  149.       close FFF;
  150.       close FFFF;
  151.       unlink($FontMap) unless(-s $FontMap);
  152.       unlink($CIDFontMap) unless(-s $CIDFontMap);
  153.       unlink($FAPIfmap) unless(-s $FAPIfmap);
  154.       unlink($Cidfmap) unless(-s $Cidfmap);
  155.     }
  156.     
  157.     defoma_id_close_cache($Id);
  158.     $Id = 0;
  159.   }
  160.   if ($IdCmap) {
  161.     defoma_id_close_cache($IdCmap);
  162.     $IdCmap = 0;
  163.   }
  164.   if ($Sb1) {
  165.     defoma_subst_close($Sb1);
  166.     $Sb1 = 0;
  167.   }
  168.   if ($Sb2) {
  169.     defoma_subst_close($Sb2);
  170.     $Sb2 = 0;
  171.   }
  172.   
  173.   return 0;
  174. }
  175.  
  176. sub create_symlink {
  177.   my $font = shift;
  178.   my $dir = shift || $FontDir;
  179.   
  180.   if ($font =~ /^(.*)\/(.+)$/) {
  181.     my $fontpath = $1;
  182.     my $fontfile = $2;
  183.     my $newfile = $dir . '/' . $fontfile;
  184.     
  185.     return 1 if (-e $newfile);
  186.     
  187.     symlink($font, $newfile) || return 1;
  188.   } else {
  189.     return 1;
  190.   }
  191.   
  192.   return 0;
  193. }
  194.  
  195. sub remove_symlink {
  196.   my $font = shift;
  197.   my $dir = shift || $FontDir;
  198.   
  199.   if ($font =~ /^(.*)\/(.+)$/) {
  200.     my $fontpath = $1;
  201.     my $fontfile = $2;
  202.     my $newfile = $dir . '/' . $fontfile;
  203.     
  204.     return 1 unless (-l $newfile);
  205.     
  206.     unlink($newfile);
  207.   } else {
  208.     return 1;
  209.   }
  210.   
  211.   return 0;
  212. }
  213.  
  214. sub register_ps {
  215.   my $id = shift;
  216.   
  217.   defoma_font_register('postscript', '<gs>/' . $id, @_);
  218. }
  219.  
  220. sub unregister_ps {
  221.   my $id = shift;
  222.   
  223.   if (defoma_font_if_register('postscript', '<gs>/' . $id)) {
  224.     defoma_font_unregister('postscript', '<gs>/' . $id);
  225.   }
  226. }
  227.  
  228. sub t1_register {
  229.   my $type = shift;
  230.   my $font = shift;
  231.   my $h = parse_hints_start(@_);
  232.   
  233.   my $fontname = $h->{FontName};
  234.   return 1 unless ($fontname);
  235.   $fontname =~ s/ .*//;
  236.   
  237.   my $priority = $h->{Priority} || 0;
  238.   
  239.   my %add;
  240.   $add{hints} = join(' ', @_);
  241.   
  242.   if ($type eq 'gsfontderivative') {
  243.     my $ofont = $h->{'GSF-OriginFont'};
  244.     my $oid = $h->{'GSF-OriginID'};
  245.     
  246.     if ($ofont && $oid) {
  247.       $add{depend} = $ofont.' '.$oid;
  248.     } else {
  249.       return 2;
  250.     }
  251.   }
  252.   
  253.   return 3 if (create_symlink($font));
  254.   
  255.   defoma_id_register($Id, type => 'real', font => $font, id => $fontname,
  256.              priority => $priority, %add);
  257.   
  258.   my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  259.   my $i;
  260.   
  261.   foreach $i (@alias) {
  262.     defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  263.                priority => $priority, origin => $fontname);
  264.   }
  265.   
  266.   defoma_subst_register($Sb1, $font, $fontname);
  267.   defoma_subst_register($Sb2, $font, $fontname);
  268.   
  269.   return 0;
  270. }
  271.  
  272. sub t1_unregister {
  273.   my $font = shift;
  274.   
  275.   defoma_subst_unregister($Sb1, $font);
  276.   defoma_subst_unregister($Sb2, $font);
  277.   defoma_id_unregister($Id, type => 'alias', font => $font);
  278.   defoma_id_unregister($Id, type => 'real', font => $font);
  279.   
  280.   remove_symlink($font);
  281.   
  282.   return 0;
  283. }
  284.  
  285. sub t1_install {
  286.   my $type = shift;
  287.   my $font = shift;
  288.   my $id = shift;
  289.   my $depfont = shift;
  290.   my $depid = shift;
  291.   my @add = ();
  292.   
  293.   if ($type eq 'real') {
  294.     return 0 if (grep($_ eq '--Alias', @_));
  295.     
  296.     $add[0] = '--RealName';
  297.   }
  298.   
  299.   register_ps($id, @_, @add);
  300.   
  301.   return 0;
  302. }
  303.  
  304. sub t1_remove {
  305.   my $type = shift;
  306.   my $font = shift;
  307.   my $id = shift;
  308.   my $depfont = shift;
  309.   my $depid = shift;
  310.   
  311.   unregister_ps($id);
  312.   
  313.   return 0;
  314. }
  315.  
  316. sub type1 {
  317.   my $com = shift;
  318.   
  319.   if ($com eq 'register') {
  320.     return t1_register('type1', @_);
  321.   } elsif ($com eq 'unregister') {
  322.     return t1_unregister(@_);
  323.   } elsif ($com =~ /^do-install-(.*)$/) {
  324.     return t1_install($1, @_);
  325.   } elsif ($com =~ /^do-remove-(.*)$/) {
  326.     return t1_remove($1, @_);
  327.   } elsif ($com eq 'init') {
  328.     return init();
  329.   } elsif ($com eq 'term') {
  330.     return term();
  331.   }
  332.   
  333.   return 0;
  334. }
  335.  
  336. sub type3 {
  337.   return type1(@_);
  338. }
  339.  
  340. sub gsfontderivative {
  341.   my $com = shift;
  342.   
  343.   if ($com eq 'register') {
  344.     return t1_register('gsfontderivative', @_);
  345.   } else {
  346.     return type1($com, @_);
  347.   }
  348. }
  349.  
  350. sub tt_register_cjk {
  351.   my %addstr = ('Japanese' => '-Ja',
  352.         'Korean' => '-Ko',
  353.         'Chinese-China' => '-GB',
  354.         'Chinese-Taiwan' => '-CNS');
  355.   my %ordering = ('Japanese' => 'Japan1',
  356.           'Korean' => 'Korea1',
  357.           'Chinese-China' => 'GB1',
  358.           'Chinese-Taiwan' => 'CNS1');
  359.   my %coding = ('Unicode' => 'Unicode',
  360.         'BIG5' => 'Big5',
  361.         'ShiftJIS' => 'ShiftJIS',
  362.         'WanSung' => 'WanSung',
  363.         'Johab' => 'Johab');
  364.   
  365.   my $cnt = shift;
  366.   my $loc = shift;
  367.   my $font = shift;
  368.   my $fontname = shift;
  369.   my $alias = shift;
  370.   my $charset = shift;
  371.   my $encoding = shift;
  372.   my $priority = shift;
  373.   
  374.   return $cnt unless (exists($addstr{$loc}) && exists($ordering{$loc}) &&
  375.               exists($coding{$encoding}));
  376.   my $ord = $ordering{$loc};
  377.   my $enc = $coding{$encoding};
  378.   
  379.   my $add = '';
  380.   $add = $addstr{$loc} if ($cnt > 0);
  381.   
  382.   my @hints = ('Adobe', $ord, $enc,
  383.            '--CIDRegistry', 'Adobe', '--CIDOrdering', $ord);
  384.   
  385.   defoma_id_register($Id, type => 'real', font => $font,
  386.              id => $fontname . $add, priority => $priority,
  387.              category => 'truetype-cjk',
  388.              hints => join(' ', @hints, @_));
  389.   
  390.   foreach my $i (@{$alias}) {
  391.     defoma_id_register($Id, type => 'alias', font => $font,
  392.                id => $i . $add, priority => $priority,
  393.                category => 'truetype-cjk',
  394.                origin => $fontname . $add);
  395.   }
  396.   
  397.   defoma_subst_register($Sb1, $font, $fontname . $add);
  398.   defoma_subst_register($Sb2, $font, $fontname . $add);
  399.   
  400.   $cnt++;
  401.   return $cnt unless ($charset =~ /JISX0212/ && $loc eq 'Japanese' &&
  402.               $encoding eq 'Unicode');
  403.   
  404.   $add = '-JaH';
  405.   @hints = ('Adobe', 'Japan2', 'Unicode',
  406.         '--CIDRegistry', 'Adobe', '--CIDOrdering', 'Japan2');
  407.   
  408.   defoma_id_register($Id, type => 'real', font => $font,
  409.              id => $fontname . $add, priority => $priority,
  410.              category => 'truetype-cjk',
  411.              hints => join(' ', @hints, @_));
  412.   
  413.   foreach my $i (@{$alias}) {
  414.     defoma_id_register($Id, type => 'alias', font => $font,
  415.                id => $i . $add, priority => $priority,
  416.                category => 'truetype-cjk',
  417.                origin => $fontname . $add);
  418.   }
  419.   
  420.   defoma_subst_register($Sb1, $font, $fontname . $add);
  421.   defoma_subst_register($Sb2, $font, $fontname . $add);
  422.   
  423.   $cnt++;
  424.   return $cnt;
  425. }
  426.  
  427. sub tt_register {
  428.   my $font = shift;
  429.   my $h = parse_hints_start(@_);
  430.   my $i;
  431.   
  432.   my $fontname = $h->{FontName};
  433.   my $location = $h->{Location};
  434.   my $encoding = $h->{Encoding};
  435.   my $priority = $h->{Priority} || 0;
  436.   my $charset = $h->{Charset};
  437.   
  438.   return 1 unless ($fontname && $location && $encoding);
  439.   $fontname =~ s/ .*//;
  440.   my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  441.   
  442.   return 2 if (create_symlink($font));
  443.   
  444.   parse_hints_cut($h, 'Encoding', 'Location', 'FontName');
  445.   my @hints;
  446.   
  447.   if ($location !~ /Japanese|Korean|Chinese/) {
  448.     @hints = parse_hints_build($h);
  449.     
  450.     defoma_id_register($Id, type => 'real', font => $font, id => $fontname,
  451.                priority => $priority, hints => join(' ', @hints));
  452.     
  453.     foreach $i (@alias) {
  454.       defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  455.              priority => $priority, origin => $fontname);
  456.     }
  457.     
  458.     defoma_subst_register($Sb1, $font, $fontname);
  459.     defoma_subst_register($Sb2, $font, $fontname);
  460.   } else {
  461.     parse_hints_cut($h, 'Charset');
  462.     @hints = parse_hints_build($h);
  463.     
  464.     my $loc;
  465.     my @locs = split(/ /, $location);
  466.     my $cnt = 0;
  467.     
  468.     foreach $loc (@locs) {
  469.       $cnt = tt_register_cjk($cnt, $loc, $font, $fontname, \@alias,
  470.                  $charset, $encoding, $priority, @hints);
  471.     }
  472.   }
  473.   
  474.   return 0;
  475. }
  476.  
  477. sub tt_unregister {
  478.   my $font = shift;
  479.   
  480.   defoma_subst_unregister($Sb1, $font);
  481.   defoma_subst_unregister($Sb2, $font);
  482.   defoma_id_unregister($Id, type => 'alias', font => $font);
  483.   defoma_id_unregister($Id, type => 'real', font => $font);
  484.   
  485.   remove_symlink($font);
  486.   
  487.   return 0;
  488. }
  489.  
  490. sub tt_install {
  491.   my $type = shift;
  492.   my $font = shift;
  493.   my $id = shift;
  494.   my $depfont = shift;
  495.   my $depid = shift;
  496.   
  497.   my @add = ();
  498.   
  499.   $add[0] = '--RealName' if ($type eq 'real');
  500.   
  501.   register_ps($id, @_, @add);
  502.   
  503.   return 0;
  504. }
  505.  
  506. sub tt_remove {
  507.   my $type = shift;
  508.   my $font = shift;
  509.   my $id = shift;
  510.   my $depfont = shift;
  511.   my $depid = shift;
  512.   
  513.   unregister_ps($id);
  514.   
  515.   return 0;
  516. }
  517.  
  518. sub truetype {
  519.   my $com = shift;
  520.   
  521.   if ($com eq 'register') {
  522.     return tt_register(@_);
  523.   } elsif ($com eq 'unregister') {
  524.     return tt_unregister(@_);
  525.   } elsif ($com =~ /^do-install-(.*)$/) {
  526.     return tt_install($1, @_);
  527.   } elsif ($com =~ /^do-remove-(.*)$/) {
  528.     return tt_remove($1, @_);
  529.   } elsif ($com eq 'init') {
  530.     return init();
  531.   } elsif ($com eq 'term') {
  532.     return term();
  533.   }
  534.   
  535.   return 0;
  536. }
  537.  
  538. sub truetype_cjk {
  539.   my $com = shift;
  540.   
  541.   if ($com =~ /^do-install-(.*)$/) {
  542.     return cid_install($1, @_);
  543.   } elsif ($com =~ /^do-remove-(.*)$/) {
  544.     return cid_remove($1, @_);
  545.   } elsif ($com eq 'init') {
  546.     return init();
  547.   } elsif ($com eq 'term') {
  548.     return term();
  549.   }
  550.  
  551.   return 0;
  552. }
  553.  
  554. sub cid_register {
  555.   my $type = shift;
  556.   my $font = shift;
  557.   my $h = parse_hints_start(@_);
  558.  
  559.   my $fontname = $h->{FontName};
  560.   my $registry = $h->{CIDRegistry};
  561.   my $ordering = $h->{CIDOrdering};
  562.   my $priority = $h->{Priority} || 0;
  563.     
  564.   return 1 unless($fontname && $registry && $ordering);
  565.   $fontname =~ s/ .*//;
  566.   $registry =~ s/ .*//;
  567.   $ordering =~ s/ .*//;
  568.   my @alias = ($h->{Alias}) ? split(/ +/, $h->{Alias}) : ();
  569.  
  570.   return 2 if (create_symlink($font));
  571.  
  572.   parse_hints_cut($h, 'PSCharset', 'PSEncoding', 'Charset', 'Encoding');
  573.   my @hints = parse_hints_build($h);
  574.   @hints = ($registry, $ordering, '.', @hints);
  575.  
  576.   defoma_id_register($Id, type => 'real', font => $font,
  577.              id => $fontname, priority => $priority,
  578.              category => $type, hints => join(' ', @hints));
  579.  
  580.   my $i;
  581.   foreach $i (@alias) {
  582.     defoma_id_register($Id, type => 'alias', font => $font, id => $i,
  583.                priority => $priority, origin => $fontname,
  584.                category => $type);
  585.   }
  586.  
  587.   defoma_subst_register($Sb1, $font, $fontname);
  588.   defoma_subst_register($Sb2, $font, $fontname);
  589.     
  590.   return 0;
  591. }
  592.     
  593. sub cid_unregister {
  594.   my $font = shift;
  595.  
  596.   defoma_subst_unregister($Sb1, $font);
  597.   defoma_subst_unregister($Sb2, $font);
  598.   defoma_id_unregister($Id, type => 'alias', font => $font);
  599.   defoma_id_unregister($Id, type => 'real', font => $font);
  600.  
  601.   remove_symlink($font);
  602.  
  603.   return 0;
  604. }
  605.  
  606. sub cid_install_all {
  607.   my $type = shift;
  608.   my $id = shift;
  609.   my $registry = shift;
  610.   my $ordering = shift;
  611.     
  612.   my @cmaps = defoma_id_get_font($IdCmap, 'installed');
  613.   foreach my $c (@cmaps) {
  614.     my @chs = split(/ +/, $IdCmap->{7}->[$c]);
  615.  
  616.     next if ($chs[0] ne $registry);
  617.     next if ($chs[1] ne $ordering && $chs[1] ne 'Identity');
  618.  
  619.     shift(@chs);
  620.     shift(@chs);
  621.     
  622.     my $psname = $id . '-' . $IdCmap->{0}->[$c];
  623.  
  624.     my @add = ();
  625.     $add[0] = '--RealName' if ($type eq 'real');
  626.     
  627.     register_ps($psname, @_, @add, @chs);
  628.   }
  629.  
  630.   return 0;
  631. }
  632.  
  633. sub cid_remove_all {
  634.   my $type = shift;
  635.   my $id = shift;
  636.   my $registry = shift;
  637.   my $ordering = shift;
  638.     
  639.   my @cmaps = defoma_id_get_font($IdCmap, 'installed');
  640.   foreach my $c (@cmaps) {
  641.     my @chs = split(/ +/, $IdCmap->{7}->[$c]);
  642.  
  643.     next if ($chs[0] ne $registry);
  644.     next if ($chs[1] ne $ordering && $chs[1] ne 'Identity');
  645.  
  646.     my $psname = $id . '-' . $IdCmap->{0}->[$c];
  647.  
  648.     unregister_ps($psname);
  649.   }
  650.  
  651.   return 0;
  652. }
  653.  
  654. sub cid_install {
  655.   my $type = shift;
  656.   my $font = shift;
  657.   my $id = shift;
  658.   my $depfont = shift;
  659.   my $depid = shift;
  660.   my $registry = shift;
  661.   my $ordering = shift;
  662.   my $encoding = shift;
  663.  
  664.   cid_install_all($type, $id, $registry, $ordering, @_);
  665.  
  666.   return 0;
  667. }
  668.  
  669. sub cid_remove {
  670.   my $type = shift;
  671.   my $font = shift;
  672.   my $id = shift;
  673.   my $depfont = shift;
  674.   my $depid = shift;
  675.   my $registry = shift;
  676.   my $ordering = shift;
  677.   my $encoding = shift;
  678.  
  679.   cid_remove_all($type, $id, $registry, $ordering);
  680.     
  681.   return 0;
  682. }
  683.  
  684. sub cid {
  685.   my $com = shift;
  686.  
  687.   if ($com eq 'register') {
  688.     return cid_register('cid', @_);
  689.   } elsif ($com eq 'unregister') {
  690.     return cid_unregister(@_);
  691.   } elsif ($com =~ /^do-install-(.*)$/) {
  692.     return cid_install($1, @_);
  693.   } elsif ($com =~ /^do-remove-(.*)$/) {
  694.     return cid_remove($1, @_);
  695.   } elsif ($com eq 'init') {
  696.     return init();
  697.   } elsif ($com eq 'term') {
  698.     return term();
  699.   }
  700.  
  701.   return 0;
  702. }
  703.  
  704. sub cmap_register {
  705.   my $font = shift;
  706.  
  707.   if ($font =~ /\/gs-cjk-resource\//) {
  708.     return 2 if (create_symlink($font, $CMapDir));
  709.     return 0;
  710.   }
  711.     
  712.   my $h = parse_hints_start(@_);
  713.  
  714.   my $cmap = $h->{CMapName};
  715.   my $reg = $h->{CIDRegistry};
  716.   my $ord = $h->{CIDOrdering};
  717.     
  718.   return 1 unless ($cmap && $reg && $ord);
  719.   $reg =~ s/ .*//;
  720.   $ord =~ s/ .*//;
  721.   $cmap =~ s/ .*//;
  722.     
  723.   my @hints = ($reg, $ord, @_);
  724.  
  725.   defoma_id_register($IdCmap, type => 'real', font => $font, id => $cmap,
  726.              priority => 0, hints => join(' ', @hints));
  727.  
  728.   return 0;
  729. }
  730.  
  731. sub cmap_unregister {
  732.   my $font = shift;
  733.  
  734.   if ($font =~ /\/gs-cjk-resource\//) {
  735.     remove_symlink($font, $CMapDir);
  736.     return 0;
  737.   }
  738.     
  739.   defoma_id_unregister($IdCmap, type => 'real', font => $font);
  740.  
  741.   return 0;
  742. }
  743.  
  744. sub cmap_install {
  745.   my $font = shift;
  746.   my $cmap = shift;
  747.   my $df = shift;
  748.   my $di = shift;
  749.   my $reg = shift;
  750.   my $ord = shift;
  751.   my %hash;
  752.   my @nonreal = ();
  753.     
  754.   return 1 if (create_symlink($font, $CMapDir));
  755.  
  756.   my @list = (defoma_id_get_font($Id, 'installed', f4 => 'cid'),
  757.           defoma_id_get_font($Id, 'installed', f4 => 'truetype-cjk'));
  758.     
  759.   foreach my $i (@list) {
  760.     my $type = $Id->{2}->[$i];
  761.     my $id = $Id->{0}->[$i];
  762.     
  763.     if ($type ne 'SrI') {
  764.       push(@nonreal, $i);
  765.       next;
  766.     }
  767.  
  768.     my @hints = split(/ +/, $Id->{7}->[$i]);
  769.  
  770.     next if ($hints[0] ne $reg);
  771.     next if ($hints[1] ne $ord && $ord ne 'Identity');
  772.  
  773.     $hash{$id} = $i;
  774.  
  775.     shift(@hints);
  776.     shift(@hints);
  777.     shift(@hints);
  778.  
  779.     my $psname = $id . '-' . $cmap;
  780.  
  781.     register_ps($psname, @hints, '--RealName', @_);
  782.   }
  783.  
  784.   foreach my $i (@nonreal) {
  785.     my $depid = $Id->{5}->[$i];
  786.     next unless (exists($hash{$depid}));
  787.     
  788.     my @hints = split(/ +/, $Id->{7}->[$hash{$depid}]);
  789.  
  790.     next if ($hints[0] ne $reg);
  791.     next if ($hints[1] ne $ord && $ord ne 'Identity');
  792.  
  793.     shift(@hints);
  794.     shift(@hints);
  795.     shift(@hints);
  796.  
  797.     my $psname = $Id->{0}->[$i] . '-' . $cmap;
  798.  
  799.     register_ps($psname, @hints, @_);
  800.   }
  801.  
  802.   return 0;
  803. }
  804.  
  805. sub cmap_remove {
  806.   my $font = shift;
  807.   my $cmap = shift;
  808.   my $df = shift;
  809.   my $di = shift;
  810.   my $reg = shift;
  811.   my $ord = shift;
  812.   my %hash;
  813.  
  814.   remove_symlink($font, $CMapDir);
  815.  
  816.   my @list = (defoma_id_get_font($Id, 'installed', f4 => 'cid'),
  817.           defoma_id_get_font($Id, 'installed', f4 => 'truetype-cjk'));
  818.  
  819.   foreach my $i (@list) {
  820.     my @hints = split(/ +/, $Id->{7}->[$i]);
  821.  
  822.     if (@hints > 0) {
  823.       next if ($hints[0] ne $reg);
  824.       next if ($hints[1] ne $ord && $ord ne 'Identity');
  825.     }
  826.     
  827.     my $psname = $Id->{0}->[$i] . '-' . $cmap;
  828.  
  829.     unregister_ps($psname);
  830.   }
  831.     
  832.   return 0;
  833. }
  834.  
  835. sub cmap {
  836.   my $com = shift;
  837.  
  838.   if ($com eq 'register') {
  839.     return cmap_register(@_);
  840.   } elsif ($com eq 'unregister') {
  841.     return cmap_unregister(@_);
  842.   } elsif ($com eq 'do-install-real') {
  843.     return cmap_install(@_);
  844.   } elsif ($com eq 'do-remove-real') {
  845.     return cmap_remove(@_);
  846.   } elsif ($com eq 'init') {
  847.     return init();
  848.   } elsif ($com eq 'term') {
  849.     return term();
  850.   }
  851.  
  852.   return 0;
  853. }
  854.  
  855. sub psprint_register {
  856.   my $font = shift;
  857.   return 0 unless ($Subst4psprint);
  858.   return 1 if ($font !~ /(.+)\/(.+)/);
  859.  
  860.   return 0 if ($1 eq '<gs>');
  861.   my $fontname = $2;
  862.  
  863.   return 2 if ($Sb1->grep_rule('', $fontname));
  864.  
  865.   my @hints;
  866.   my $h = parse_hints_start(@_);
  867.   my $cset = $h->{PSCharset};
  868.   my $enc = $h->{PSEncoding};
  869.     
  870.   if ($cset && $enc && $cset =~ /^Adobe-([^-]+).*$/) {
  871.     my $ord = $1;
  872.     $fontname =~ s/-$enc$//;
  873.  
  874.     parse_hints_cut($h, 'PSCharset', 'PSEncoding', 'Charset', 'Encoding',
  875.             'Direction');
  876.     @hints = parse_hints_build($h);
  877.     push(@hints, '--CIDRegistry,*', 'Adobe', '--CIDOrdering,*', $ord);
  878.   } else {
  879.     @hints = @_;
  880.   }
  881.  
  882.   for my $i (@hints) {
  883.     $i = '--Charset,*' if ($i eq '--Charset');
  884.     $i = '--Encoding,*' if ($i eq '--Encoding');
  885.     $i = '--Direction,*' if ($i eq '--Direction');
  886.     $i = '--Shape,2' if ($i eq '--Shape');
  887.   }
  888.     
  889.   defoma_subst_add_rule($Sb1, $fontname, @hints);
  890.  
  891.   return 0;
  892. }
  893.  
  894. sub psprint_unregister {
  895.   my $font = shift;
  896.   return 0 if ($font !~ /(.+)\/(.+)/);
  897.  
  898.   return 0 if ($1 eq '<gs>');
  899.   my $fontname = $2;
  900.  
  901.   my $h = parse_hints_start(@_);
  902.   my $cset = $h->{PSCharset};
  903.   my $enc = $h->{PSEncoding};
  904.  
  905.   if ($cset && $enc && $cset =~ /^Adobe-.*$/) {
  906.     $fontname =~ s/-$enc$//;
  907.   }
  908.  
  909.   defoma_subst_remove_rule($Sb1, $fontname);
  910.  
  911.   return 0;
  912. }
  913.  
  914. sub psprint {
  915.   my $com = shift;
  916.   
  917.   if ($com eq 'register') {
  918.     return psprint_register(@_);
  919.   } elsif ($com eq 'unregister') {
  920.     return psprint_unregister(@_);
  921.   } elsif ($com eq 'init') {
  922.     return init();
  923.   } elsif ($com eq 'term') {
  924.     return term();
  925.   }
  926.   
  927.   return 0;
  928. }
  929.  
  930. 1;
  931.